(PROG (SEXPR IBASE) 
      (SETQ IBASE (ADD1 7)) 
 LOOP (SETQ SEXPR (ERRSET (READ))) 
      (COND ((EQ SEXPR (QUOTE $EOF$)) (RETURN (QUOTE SOSLINK-LOADED)))) 
      (EVAL (CAR SEXPR)) 
      (GO LOOP)) 
 
(DECLARE (SPECIAL FILENAME EXPRLOC IGLIST GOODPROPS))
 

(DEFPROP FILEIN 
 (LAMBDA (FILES) 
       (PROG (FILENAME EXPRLOC XP TEM) 
	     (SETQ TEM (GETL @ NEWREAD @ (EXPR SUBR))) 
	     (PUTPROP @ READ (CADR TEM) (CAR TEM)) 
	     (SETQ TEM (GETL @ NEWDEFPROP @ (FEXPR FSUBR))) 
	     (PUTPROP @ DEFPROP (CADR TEM) (CAR TEM)) 
	     (SETQ TEM (GETL @ NEWPUTPROP @ (EXPR SUBR))) 
	     (PUTPROP @ PUTPROP (CADR TEM) (CAR TEM)) 
	OLOOP(COND ((NULL FILES) (GO END))) 
	     (SETQ FILENAME (CAR FILES)) 
	     (EVAL (LIST @ INPUT  @ DSK: FILENAME)) 
	     (INC T NIL) 
	ILOOP(COND ((ATOM (SETQ XP (ERRSET (READ)))) (GO NEXTF))) 
	     (PRINT (EVAL (CAR XP))) 
	     (GO ILOOP) 
	NEXTF(INC NIL T) 
	     (SETQ FILES (CDR FILES)) 
	     (GO OLOOP) 
	END  (REMPROP  @ PUTPROP @ EXPR) 
	     (REMPROP @ READ @ EXPR) 
	     (REMPROP @ DEFPROP @ FEXPR) 
	     (OLDPUTPROP @ PUTPROP (GET @ OLDPUTPROP @ SUBR) @ SUBR) 
	     (PUTPROP @ READ (GET @ OLDREAD @ SUBR) @ SUBR) 
	     (PUTPROP @ DEFPROP (GET @ OLDDEFPROP @ FSUBR) @ FSUBR) 
	     (RETURN NIL))) 
 FEXPR) 
 

(PUTPROP (QUOTE OLDREAD) (GET (QUOTE READ) (QUOTE SUBR)) (QUOTE SUBR)) 

(DEFPROP NEWREAD 
 (LAMBDA NIL
  (PROG NIL 
   LOOP (COND ((MEMQ (NEXTTYI) IGLIST) (TYI) (GO LOOP)))
	(SETQ EXPRLOC (CONS FILENAME (PGLINE))) 
	(RETURN (OLDREAD)))) 
 EXPR)

(PUTPROP @ OLDDEFPROP (GET @ DEFPROP @ FSUBR) @ FSUBR) 

(DEFPROP NEWDEFPROP
 (LAMBDA (L) (PROG2 (PUTPROP (CAR L) (CADR L) (CADDR L)) (CAR L)))
 FEXPR) 

(PUTPROP @ OLDPUTPROP (GET @ PUTPROP @ SUBR) @ SUBR) 
 
(DEFPROP NEWPUTPROP 
 (LAMBDA(AT PROP IND)
  (PROG (FRAG)
	(COND ((NOT (GET IND @ SWAPIT)) 
	       (RETURN (OLDPUTPROP AT PROP IND)))) 
	(SETQ FRAG (GETL AT (LIST IND)))
	(COND
	 ((NULL FRAG) 
	  (RPLACD AT 
		  (CONS IND (CONS PROP 
			    (CONS @ SWAPPROP 
				  (CONS EXPRLOC (CDR AT)))))) 
	  (RETURN PROP)))
	(RPLACD FRAG 
		(CONS PROP (CONS @ SWAPPROP 
				 (CONS EXPRLOC 
				       (COND ((EQ (CADDR FRAG) @ SWAPPROP) 
					      (CDDDDR FRAG)) 
					     (T (CDDR FRAG)))))))
	(RETURN PROP))) 
EXPR)
 
(DEFPROP EXPR T SWAPIT)
(DEFPROP FEXPR T SWAPIT) 
(DEFPROP MACRO T SWAPIT) 


(DF EDFUN (FUN) 
   (PROG (FILE PAGE LINE LOC) 
	(COND ((NOT (GETL (CAR FUN) @ (SWAPPROP))) 
	       (PRINT @ NO/ SWAP/ INFO) 
	       (RETURN NIL))) 
	(TERPRI) 
	(COND ((NULL (CDR FUN)) 
	       (SETQ LOC (CADR (GETL (CAR FUN) @ (SWAPPROP))))) 
	      (T (SETQ LOC (CADDDR (GETL (CAR FUN) (CDR FUN)))))) 
	(SETQ FILE (CAR LOC)) 
	(SETQ PAGE (CADR LOC)) 
	(SETQ LINE (CDDR LOC)) 
	(EVAL (LIST @ OUTPUT @ DSK: (CONS @ SAVLSP @ CMD))) 
	(OUTC T NIL) 
	(PRINC @ G/ ) 
	(PRINC @ SAVLSP) 
	(PRINC @ /.) 
	(PRINC @ DMP) 
	(PRINC @ ↔)
	(PRINC @ REE/ )
	(TYO 27) 
	(TERPRI) 
	(PRINC @ / ) 
	(PRIN1 (LIST @ READ1EXPR FILE PAGE LINE)) 
	(TYO 33) 
	(OUTC NIL T) 
	(EVAL (LIST @ OUTPUT @ DSK: (CONS @ QQSVCM @ RPG))) 
	(OUTC T NIL) 
	(PRINC @ COM/ ) 
	(PRINC @ SAVLSP) 
	(PRINC @ /.) 
	(PRINC @ CMD) 
	(PRINC @ //NON/ ) 
	(PRINC @ DO/[1/,3/]) 
	(OUTC NIL T) 
	(PRINT @ PAGE) 
	(PRINC PAGE) 
	(TERPRI) 
	(SOSSWAP FILE PAGE LINE NIL))) 
 
(SETQ IGLIST @ (11 12 14 15 40))
 

(DEFSYM @ SOS 370000) 
(DEFSYM @ SUBI 275000) 
(DEFSYM @ SOJE 362000) 
 
(DEFSYM @ TYI 1027) 
(DEFSYM @ OLDCH 1112) 
(DEFSYM @ INUM0 (MAKNUM 0 @ FIXNUM))
 
(LAP FINDPAGE SUBR) 
	(SUBI 1 INUM0) 
	(PUSH P 1) 
LOOP	(MOVE 1 0 P) 
	(SOJE 1 END) 
ILOOP	(PUSHJ P TYI) 
	(CAIE 1 14) 
	(JRST 0 ILOOP) 
	(SOS 0 0 P) 
	(JRST 0 LOOP) 
END	(SUB P (C 0 0 1 1)) 
	(POPJ P) 
	NIL 
 
(LAP NEXTTYI SUBR) 
	(PUSHJ P TYI) 
	(MOVEM 1 OLDCH) 
	(JRST 0 FIX1A) 
	NIL 
 
(DF READ1EXPR (ARGS) 
    (PROG (VAL) 
	  (EVAL (LIST @ INPUT @ DSK: (CAR ARGS))) 
	  (INC T NIL) 
	  (FINDPAGE (CADR ARGS)) 
     LOOP (NEXTTYI) 
	  (COND ((EQUAL (CADDR ARGS) (CDR (PGLINE))) 
		 (GO END))) 
	  (TYI) 
	  (GO LOOP) 
     END  (SETQ VAL (EVAL (READ))) 
	  (INC NIL T) 
	  (RETURN VAL))) 
 

(DEFSYM @ ADDI 271000)
(DEFSYM @ CALLI 47000)
(DEFSYM @ DPB 137000)
(DEFSYM @ HRLI 505000)
(DEFSYM @ IDIVI 231000)
(DEFSYM @ IDPB 136000)
(DEFSYM @ ILDB 134000)
(DEFSYM @ SKIPE 332000)
(DEFSYM @ SOJG 367000)
(DEFSYM @ TLNN 607000)
(DEFSYM @ TRO 660000)
(DEFSYM @ TTYUUO 51000)

(LAP SOSSWAP SUBR)
	(MOVEM 1 FNAME) ~FNAME.EXT
	(SUBI 2 INUM0)
	(MOVEM 2 FPAGE) ~PAGE NUMBER
	(MOVEM 4 CMODE)
	(MOVE 1 3)
	(PUSHJ P MKLINUM)
	(MOVEM 1 FLINE) ~LINE NUMBER
	(MOVE 1 FNAME)
	(CALL 1 (E ATOM))
	(JUMPE 1 DOTTED)
	(MOVE 1 FNAME)
	(MOVEI 2 (QUOTE / / / / / / ))
	(CALL 2 (E CONS))
	(MOVEM 1 FNAME)
DOTTED	(HLRZ@ 1 FNAME)
	(MOVEI 2 (QUOTE PNAME))
	(CALL 2 (E GET))
	(PUSHJ P MAKSIX)
	(PUSH P 1)
	(HRRZ@ 1 FNAME)
	(MOVEI 2 (QUOTE PNAME))
	(CALL 2 (E GET))
	(PUSHJ P MAKSIX)
	(POP P 14)
	(MOVE 15 FLINE)
	(MOVE 16 FPAGE)
	(MOVE 13 1)
	(SKIPE 0 CMODE)
	(TRO 13 400000)
	(MOVEI 11 NIL)
	(CALLI 11 24) 	~GETPPN UUO
	(MOVE 1 (C SAV 0 RUN))
	(TTYUUO 11)	~CLRBFI
	(CALLI 1 400004) 	~SWAP UUO


FNAME	(0)
FPAGE	(0)
FLINE	(0)
CMODE	(0)

SAV	(446353 000000) ~'DSK   '
	(634166 0 546360) ~'SAVLSP'
	(445560 000000) ~'DMP   '
	(0) ~SAME JOBSA
	(0) ~SAME PPN
RUN	(446353 000000) ~'DSK   '
	(635763 000000) ~'SOS   '
	(445560 000000) ~'DMP   '
	(0 0 1) ~JOBSA + 1
	(000021 0 000023) ~'  1  3'
MAKSIX	(PUSH P 1)
	(MOVEI 5 5)
	(MOVE 2 (C 440600 0 1 0))
	(MOVEI 1 NIL)
MKSIX1	(HLRZ@ 4 0 P)
	(HRLI 4,440700)
INLUP	(ILDB 3 4)
	(JUMPE 3 DUN7)
	(SUBI 3 40)
	(IDPB 3 2)
	(SOJG 5 INLUP)
	(MOVEI 5 1)
	(HRRZ@ 4 0 P)
	(MOVEM 4 0 P)
	(JUMPN 4 MKSIX1)
DUN7	(SUB P (C 0 0 1 1))
	(POPJ P)
MKLINUM	(MOVE 4 (C 10700 0 3))
	(SUBI 1 INUM0)
MKLINUM1(IDIVI 1 10.)
	(ADDI 2 60)
	(DPB 2 4)
	(ADD 4 (C 70000 0 0))
	(TLNN 4 400000)
	(JRST 0 MKLINUM1)
	(MOVE 1 3)
	(TRO 1 1)
	(POPJ P)
	NIL

(MAPC (FUNCTION (LAMBDA (X) (REMPROP X (QUOTE MACRO))))
      (QUOTE (EDFUN FILEIN)))